home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / misc / samples2 / extract.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-24  |  3.7 KB  |  107 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   5820
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1770
  7.    ClientWidth     =   7365
  8.    Height          =   6510
  9.    Left            =   1035
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   5820
  12.    ScaleWidth      =   7365
  13.    Top             =   1140
  14.    Width           =   7485
  15.    Begin FileListBox File1 
  16.       Height          =   3735
  17.       Left            =   180
  18.       TabIndex        =   3
  19.       Top             =   1005
  20.       Width           =   1560
  21.    End
  22.    Begin DriveListBox Drive1 
  23.       Height          =   315
  24.       Left            =   1980
  25.       TabIndex        =   2
  26.       Top             =   4455
  27.       Width           =   2130
  28.    End
  29.    Begin DirListBox Dir1 
  30.       Height          =   3180
  31.       Left            =   1935
  32.       TabIndex        =   1
  33.       Top             =   1005
  34.       Width           =   2160
  35.    End
  36.    Begin PictureBox Picture1 
  37.       AutoRedraw      =   -1  'True
  38.       AutoSize        =   -1  'True
  39.       Height          =   1335
  40.       Left            =   5325
  41.       ScaleHeight     =   1305
  42.       ScaleWidth      =   1185
  43.       TabIndex        =   0
  44.       Top             =   2985
  45.       Width           =   1215
  46.    End
  47.    Begin Menu mnuExit 
  48.       Caption         =   "Exit"
  49.    End
  50. 'Functions for extracting and drawing icons
  51. Declare Function GetModuleHandle Lib "Kernel" (ByVal lpModuleName As String) As Integer
  52. Declare Function GetClassWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
  53. Declare Function ExtractIcon Lib "SHELL" (ByVal hInst As Integer, ByVal lpszexename As String, ByVal hIcon As Integer) As Integer
  54. Declare Function DrawIcon Lib "User" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal hIcon As Integer) As Integer
  55. ' Window field offsets for GetClassWord() and GetWindowWord().
  56. Const GWW_HINSTANCE = (-6)
  57. Const GCW_HMODULE = (-16)
  58. Sub Dir1_Change ()
  59.     File1.Path = Dir1.Path
  60. End Sub
  61. Sub Drive1_Change ()
  62.     Dir1.Path = Drive1.Drive
  63. End Sub
  64. Sub File1_Click ()
  65.      Call GetIcon
  66. End Sub
  67. Sub Form_Unload (Cancel As Integer)
  68.     End
  69. End Sub
  70. Sub GetIcon ()
  71.     Dim hInst As Integer, hIcon As Integer
  72.     ' Clear the previous image from the picture box
  73.     Picture1.Picture = LoadPicture("")
  74.     'Get the instance handle for the form
  75.     hInst = GetClassWord(hWnd, GCW_HMODULE)
  76.     ' The path and filename of program to extract icon from.
  77.     lpzxExeName$ = File1.Path & "\" & File1.FileName
  78.     'Get handle to first icon in the file.
  79.     'This function will only recognize files with extensions of .exe, .dll,
  80.     'or .ico as being valid filenames, therefore, it returns 1 for any other
  81.     'extension, such as .pif.  It also returns 1 if the file DOES have an
  82.     '.exe extension but is a DOS program.
  83.     'It returns 0 for a valid filename that contains no icons
  84.     'The third argument specifies the index of the icon to be
  85.     'retrieved. If this parameter is zero, the function returns
  86.     'the handle of the first icon in the specified file. If the
  87.     'parameter is -1, the function returns the total number of
  88.     'icons in the specified file.
  89.     hIcon = ExtractIcon(hInst, lpzxExeName$, 0)
  90.     Select Case hIcon
  91.         Case 1
  92.             Msg$ = "Not a valid extension or a DOS program"
  93.             MsgBox Msg$
  94.         Case 0
  95.             Msg$ = "No icons exist in the specified file."
  96.             MsgBox Msg$
  97.         Case Else
  98.             'Draw the icon in the picture box
  99.             r% = DrawIcon(Picture1.hDC, 0, 0, hIcon)
  100.             Picture1.Refresh
  101.     End Select
  102.         
  103. End Sub
  104. Sub mnuExit_Click ()
  105.     Unload Me
  106. End Sub
  107.